home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / GETFOR.FOR < prev    next >
Text File  |  1988-02-08  |  4KB  |  149 lines
  1.       SUBROUTINE GETFOR ( NQ, QUALS, NP, PARAMS )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          GETFOR           **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          GET FOREIGN
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CALIF  94035
  19. C*          (415)694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          TO RETURN ANY PARAMETERS AND/OR QUALIFIERS ENTERED ON A FORE
  23. C*          COMMAND LINE.
  24. C*
  25. C*     METHODOLOGY :
  26. C*          USE VMS GET_FOREIGN ROUTINE THEN PARSE USING ' ' AND '/'
  27. C*          AS VALID DELIMITERS.
  28. C*
  29. C*     INPUT ARGUMENTS :
  30. C*          NONE
  31. C*
  32. C*     OUTPUT ARGUMENTS :
  33. C*          NQ     - NUMBER OF QUALIFIERS FOUND
  34. C*          QUALS  - THE LIST OF QUALIFIERS(LESS SLASH/
  35. C*          NP     - NUMBER OF PARAMETERS FOUND
  36. C*          PARAMS - THE LIST OF PARAMETERS
  37. C*
  38. C*     INTERNAL WORK AREAS :
  39. C*          NONE
  40. C*
  41. C*     COMMON BLOCKS :
  42. C*          NONE
  43. C*
  44. C*     FILE REFERENCES :
  45. C*          NONE
  46. C*
  47. C*     DATA BASE ACCESS :
  48. C*          NONE
  49. C*
  50. C*     SUBPROGRAM REFERENCES :
  51. C*          LIB$GET_FOREIGN
  52. C*
  53. C*     ERROR PROCESSING :
  54. C*          NONE
  55. C*
  56. C*     TRANSPORTABILITY LIMITATIONS :
  57. C*          UNLIKELY TO BE TRANSPORTABLE TO ANY SYSTEM BUT VMS.
  58. C*
  59. C*     ASSUMPTIONS AND RESTRICTIONS :
  60. C*          BLANKS CAN BE USED ONLY AS DELIMITERS.
  61. C*
  62. C*     LANGUAGE AND COMPILER :
  63. C*          ANSI FORTRAN 77
  64. C*
  65. C*     VERSION AND DATE :
  66. C*          VERSION I.0     24-JAN-85
  67. C*
  68. C*     CHANGE HISTORY :
  69. C*          24-JAN-85    INITIAL VERSION
  70. C*
  71. C***********************************************************************
  72. C*
  73.       CHARACTER *80 COMMAN
  74.       CHARACTER *(*) QUALS(1),PARAMS(1)
  75.       EXTERNAL SS$_NORMAL
  76. C
  77.       IP    = 0
  78.       NQ    = 0
  79.       NP    = 0
  80.       LS    = LEN(QUALS(1))
  81. C
  82. C --- RETURN COMMAND LINE (LESS FOREIGN COMMAND)
  83. C
  84.       ISTAT = LIB$GET_FOREIGN(COMMAN,,IP)
  85.       IF (ISTAT .NE. %LOC(SS$_NORMAL))RETURN
  86.       IF (IP .LE. 0 )RETURN
  87.       I = 1
  88. C
  89. C --- LOOP WHILE LINE STILL HAS CHARACTERS IN IT
  90. C
  91. 100   IF ( COMMAN(I:I) .EQ. '/' ) THEN
  92. C
  93. C --- A QUALIFIER... GET FIRST, NON-BLANK CHARACTER
  94. C
  95. 105      I = I + 1
  96.          IF (COMMAN(I:I) .EQ. ' ') THEN
  97.             IF (I .GE. IP) GO TO 300
  98.             GO TO 105
  99.          ENDIF
  100.          NQ = NQ + 1
  101.          NC = 1
  102.          QUALS(NQ) = ' '
  103. C
  104. C ----  ADD CHARACTERS UNTIL A SPACE OR SLASH FOUND, OR END OF LINE
  105. C
  106. 110      IF ((COMMAN(I:I) .EQ. ' ') .OR. (COMMAN(I:I) .EQ. '/'))
  107.      $       GO TO 120
  108.          IF (NC .LE. LS ) QUALS(NQ)(NC:NC) = COMMAN(I:I)
  109.          I = I + 1
  110.          NC = NC + 1
  111.          GO TO 110
  112. 120      IF (COMMAN(I:I) .EQ. ' ') THEN
  113.             I = I + 1
  114.             IF (I .GT. IP) GO TO 300
  115.             GO TO 120
  116.          ENDIF
  117.          GO TO 100
  118.       ELSE
  119. C
  120. C --- PARAMETER... FIRST CHARACTER IS ALREADY NON-BLANK
  121. C
  122.          NP = NP + 1
  123.          NC = 1
  124.          PARAMS(NP) = ' '
  125. C
  126. C --- ADD CHARACTERS UNTIL A BLANK OR SLASH IS FOUND
  127. C
  128. 210      IF ((COMMAN(I:I) .EQ. ' ') .OR. (COMMAN(I:I) .EQ. '/'))
  129.      $       GO TO 220
  130.          IF (NC .LE. LS) PARAMS(NP)(NC:NC) = COMMAN(I:I)
  131.          I = I + 1
  132.          NC = NC + 1
  133.          GO TO 210
  134. 220      IF (COMMAN(I:I) .EQ. ' ') THEN
  135.             I = I + 1
  136.             IF (I .GT. IP) GO TO 300
  137.             GO TO 220
  138.          ENDIF
  139.          GO TO 100
  140.       ENDIF
  141. C
  142. C --- END OF LOOP WHILE LINE STILL HAS CHARACTERS
  143. C
  144. 300   RETURN
  145.       END
  146. C
  147. C---END GETFOR
  148. C
  149.